;------------------Chapter 3 Solutions -----------------------------

; Write a function that returns union of two list and retains order. 
; new-union is that starting function.
(defun new-union (lst1 lst2)
  (cdr (reverse (union-order lst1 lst2 (list nil)))))

(defun union-order (lst1 lst2 result)
  (and (or lst1 lst2)
    (if (not (member (car lst1) result)) 
      (push (car lst1) result))
    (if (not (member (car lst2) result)) 
      (push (car lst2) result))
    (union-order (cdr lst1) (cdr lst2) result)))

;This version of union preserves order of the items in the first list and appends 
; any new item found in the second list and returns union with order. 
(defun union-v2 (lst1 lst2)
  (if (listp lst2) 
    (if (member (car lst2) lst1)
      (union-v2 lst1 (cdr lst2))
      (append lst1 (and (car lst2) (list (car lst2)))))
  lst1))
;Write a function that return a list with number of times 
; an element is present in the list. The returned list should be 
; be sorted with number of times an element occurs. 
 
(defun occurrences (lst)
  (sort-output (run-thru-list lst nil)))

(defun run-thru-list (lst output)
  (if (consp lst)
    (let ((pair (assoc (car lst) output)))
      (if (null pair)
        (run-thru-list (cdr lst) (cons (cons (car lst) 1)  output))
        (run-thru-list (cdr lst) 
          (cons 
            (cons (car pair) (+ (cdr pair) 1))
            (remove pair output)))))
    output))

(defun sort-output (output)
  (sort output 
    #'(Lambda (pair1 pair2)
      (> (cdr pair1) (cdr pair2)))))


(defun pos+rec (lst)
  "Recursive version of pos+ function"
  (defun traverse (list x)
    (if (null list)
	list 
	(cons (+ (first list) x)
	      (traverse (cdr list) (+ x 1)))))
  (traverse lst 0))
    
(defun pos+itr (numlst)
  "Iterative version of pos+ function"
  (let ((x -1) (newlist)) 
    (if (null numlst)
	nil
	(dolist (item numlst)
	  (setf newlist (cons (+ item (setf x (+ x 1))) newlist)))) 
    (reverse newlist)))


(defun pos+mcar (lst)
  "mapcar version of pos+ function"
  (let ((x -1))
    (mapcar #'(lambda (y)
		(+ y (setf x (+ x 1))))
	    lst)))

		
;;; Exercise 9 - longest path

(defconstant net '((a b c) (b c) (c d)))

(defun create-paths (grph)
  (if (null net)
      nil
      (mapcan #'(lambda (adjl)
		  (let ((strt (car adjl)))
		    (mapcar #'(lambda (e)
				(list e strt))
			    (cdr adjl))))
	      grph)))

;;;;------------------Chapter 4 Solutions -----------------------------
;;;Exercise 1.

(defun quarter-turn (ar)  
  (if (not (arrayp ar))
      (format t "This requires an array input")
      (let ((ardm (array-dimensions ar)))
	(if (not (and  
		     (eql (length ardm) 2)
		     (eql (first ardm) (second ardm))))
	    (format t "The array should be a two dimensional square array")
	    (shift-arr-column (transpose ar ardm) ardm)))))

(defun transpose (ar ardm)
; create a transpose of the input array. 
  (let ((art (make-array ardm)))
    (do ((i 0 (+ i 1)))
	((eql i (first ardm)) art)
      (do ((j 0 (+ j 1)))
	  ((eql j (second ardm)) art)
	(setf (aref art i j) (aref ar j i))))))

(defun shift-arr-column (ar ardm)
;shifts columns of the transpose array in such a way that quarter turn is achieved. 
  (let ((ars (make-array ardm)))
    (do ((i 0 (+ i 1)))
	((eql i (first ardm)) ars)
      (do ((j 0 (+ j 1)))
	  ((eql j (second ardm)) ars)
	(setf (aref ars i j) (aref ar i (- (- (first ardm) 1) j)))))))

(defun create-2D-array (1d 2d)
;utility function to create a random array.
  (let ((ar (make-array (list 1d 2d) :initial-element 0)))
    (do ((i 0 (+ i 1)))
	((eql i 1d) ar)
      (do ((j 0 (+ j 1)))
	  ((eql j 2d) ar)
	(setf (aref ar i j) (random (* 1d 2d)))))))

(defun pretty-print-arr (arr)
  (let ((ardm (array-dimensions arr)))
    (do ((i 0 (+ i 1)))
	((eql i (first ardm)) arr)
      (do ((j 0 (+ j 1)))
	  ((eql j (second ardm)) arr)
	(format t "~A " (aref arr i j)))
      (format t "~%"))))


;;; Exercise 2 - part 2-  reverse using reduce.
(defun reverse-with-reduce (lst)
  (reduce #'(lambda (a b)
	      (push b a)) 
	  lst
	  :initial-value nil))

;;; Excercise 2 - part 1 - copy-list using reduce.
(defun copy-list-with-reduce (lst)
  (reduce #'(lambda (a b)
	      (push a b)) 
	  lst
	  :initial-value nil
	  :from-end t))

;;; Exercise 3 - The case of a three legged animal!
(defstruct node3 
  elt
  (l nil)
  (c nil)
  (r nil))

(defun copy-node3-equal (tree)
  (if (null tree)
      nil
      (make-node3 
       :elt (node3-elt tree)
       :l (copy-node3-equal (node3-l tree))
       :c (copy-node3-equal (node3-c tree))
       :r (copy-node3-equal (node3-r tree)))))
	
(defun find-node3 (obj tree)
  (cond 
    ((null tree) nil)
    ((eql (node3-elt tree) obj) t)
    ((or (find-node3 obj (node3-l tree))
	 (find-node3 obj (node3-c tree))
	 (find-node3 obj (node3-r tree))) t)))


;;; Excercise 4 - a ladder made from tree.
(defstruct node2 
  elt
  (l nil)
  (r nil))

(defun bst->list (n)
  (if (not (node2-p n)) 
      nil
      (concatenate 'list 
		   (bst->list (node2-r n))
		   (list (node2-elt n))
		   (bst->list (node2-l n)))))

;;; Exercise 5 - bst-adjoin - this will refer to the node2 structure defined above. 
(defun bst-adjoin (obj bst <)
  (bst-insert obj bst <))


;;; Exercise 6 - part a  - assoc->ht 
(defun assoc->ht (alst)
  (let ((ht (make-hash-table :size (length alst))))
    (dolist (elt alst)
      (setf (gethash (car elt) ht) (cdr elt)))
    ht))

;;; Exercise 6 - part b - ht->assoc
(defun ht->assoc (ht)
  (let (acc)
    (maphash #'(lambda (k v)
		 (push (cons k v) acc))
	     ht)
    acc))
      

;;;;------------------------Chapter 5 Solutions----------------------
;;;Exercise 1 - Avoid let or let*
;; Part a
(setf y '(2 3)) ; This added just for testing purpose
((lambda (x)
  (cons x x))
  (car '(d a)))

;;Part b
(setf x '(3 3)) 
(setf z 1)
;The above two statements are just added for testing purpose
((lambda (w)
  (setf y (+ w z))
  (cons w y))
  (car x))


;;; Exercise 2 - Re-write mystery using cond. Mystery finds position of x in list y.
(defun mystery (x y)
  (cond ((null y) nil)
	((eql (car y) x) 0)
	(t (let ((z (mystery x (cdr y))))
	     (and z (+ z 1))))))


;;; Exercise 3 - Calculate squares above 5. 
(defun sqr>5 (n)
  (if (and (integerp n) 
	   (<= n 5))
      n
      (* n n)))

;;;Exercise 4 - Rewrite month-num to use case instead of svref.
(defun month-num (m y)
  (do ((d 0 d)
       (i 1 (+ i 1)))
      ((and (= i m) (<= i 12)) d)
    (case i
      ((1 3 5 7 8 10 12) (incf d 31))
      ((4 6 9 11) (incf d 30))
      ((2) (incf d (and (leap? y)
			29
			28))))))


;;; Exercise 5, part a, precedes iterative.
(defun precedes-itr (x v)
  (let (acc)
    (do ((i 1 (+ i 1)))
	((= i (length v)) acc)
      (if (eql x (svref v i))	  
	  (pushnew (svref v (- i 1)) acc)))
   acc))

;; This is another attempt at solving the same problem. But I think it is inefficient. 
(defun precedes-itr2 (x v)
  (let (prev)
    (remove-duplicates 
     (remove nil 
	     (map 'sequence #'(lambda (elt)
				(if (eql x elt)
				    prev
				    (prog2
					(setf prev elt)
					nil)))
		 v)))))
       

;;; Exercise 5, part b, precedes recursive
(defun precedes-rec (x v)
  (defun traverseVec (result pos l)
    (cond ((< pos l)
	   (if (eql x (svref v pos))
	       (pushnew (svref v (- pos 1)) result))
	   (traverseVec result (+ pos 1) l))
	  (t result)))    	
  (traverseVec nil 1 (length v)))
       

;;; Exercise 6, part a, intersperse iterative
;; Basic implementation.
(defun intersperse-itr (o l)
  (let ((acc (list (car l))))
    (dolist (x (cdr l))
      (push o acc)
      (push x acc))
    (reverse acc)))
      
;; Lisp - like implementation
(defun intersperse-itr2 (o l)
  (cdr (reverse 
	(reduce #'(lambda (result elt)	     
		    (cons elt  (cons o result)))
		l
		:initial-value nil))))

;;;Exercise 6, part b, intersperse recursive
(defun intersperse-rec (o l) 
  (defun traverse (o l acc)
    (push (car l) acc)    
    (if (cdr l)
	(progn
	  (push o acc)
	  (traverse o (cdr l) acc))
	acc))
  (traverse o (reverse l) nil))
 
;; Improved recursive version of intersperse recursive.
(defun intersperse-rec1 (o l) 
  (if (null l)
      nil
      (let ((acc (intersperse-rec1 o (cdr l))))
	(if acc
	    (push o acc))
	(push (car l) acc))))
      
;;;Exercise 7, part a, check number sequence - recursive
(defun check-num-lst (l)
  (if (null (cdr l))
      t      
      (let ((c (- (first l) (second l))))	
	(and (eql (* c c) 1)
	     (check-num-lst (cdr l))))))
	     

;;;Exercise 7, part b, check number sequence - using do*
(defun chk-num-lst-do* (l)
  (do* ((i (- (length l) 1) (- i 1))
	(a (nth i l) (nth i l))
	(b (nth (- i 1) l) (nth (- i 1) l))
	(c (- a b) (* c (- a b))))
       ((<= i 2) (if (eql (* c c) 1) t))))



;;;Exercise 7, part b, check number sequence - using do
(defun chk-num-lst-do (l)
  (do ((i (- (length l) 1) (- i 1))
       (c 1 c))	
      ((<= i 2) (if (eql (* c c) 1) t))
    (let ((a (nth i l))
	  (b (nth (- i 1) l)))
       (setf c (* c (- a b))))))


;;;Exercise 7, part c, check number sequence using mapc and return
(defun chk-num-lst-mapc (l)
  (block nil
    (mapc #'(lambda (a b)
	      (let ((c (- a b)))      
		(if (not (eql (* c c) 1))
		    (return nil))))
	  l
	  (cdr l))
    t))


;;;Exercise 8, single recursive function that returns min and max
(defun max-min (v)
  (if (>= (length v) 2)       
      (let ((mn (svref v 0))
	    (mx (svref v 1)))	
	(multiple-value-bind (max min) (max-min (subseq v 1))	  
	  (if (or (null min)
		  (< mn min))
	      (setf min mn))
	  (if (or (null max)
		  (> mx max))
	      (setf max mx))
	  (values max min)))))


;;; Exercise 9, part a, modify bfs function on page 52. 
(defun shortest-path (start end netw)
  (bfs end (list (list start)) netw))

(defun bfs (end queue netw)
  (catch 'found
    (if (null queue)
      nil
      (let ((path (car queue)))
	(let ((sp (find-if #'(lambda (p)
				(eql end (car p)))
			    queue)))	    
	(if sp
	    (throw 'found (reverse sp)))	
	(let ((node (car path)))	  
	  (bfs end 
	       (append (cdr queue)
		       (new-paths path node netw))
	       netw)))))))


(defun new-paths (path node netw)
  (mapcar #'(lambda (n)
	      (cons n path))
	  (cdr (assoc node netw))))
	      
	    
;;; Exercise 9, part b, with out catch and throw.
(defun bfs2 (end queue netw)
    (if (null queue)
      nil
      (let ((path (car queue)))
	(let ((sp (find-if #'(lambda (p)
			       (eql end (car p)))
			   queue)))	    
	(if sp
	    (reverse sp)	
	    (let ((node (car path)))
	      (if (eql node end)
		  (reverse path)
		  (bfs2 end 
			(append (cdr queue)
				(new-paths path node netw))
			netw))))))))		 

(defun shortest-path2 (start end netw)
  (bfs2 end (list (list start)) netw))


;;;;--------------------------Chapter 6 Solutions -------------------
(defun tokens (str &key (test 'constituent) (start 0))
  (format t "Function is ~A and Start is ~A~%" test start) 
  (let ((p1 (position-if test str :start start)))
    (if p1
	(let ((p2 (position-if #'(lambda (c)
				   (not (funcall test c)))
			       str :start p1)))
	  (cons (subseq str p1 p2)
		(if p2
		    (tokens str test p2)
		    nil)))
	nil)))

(defun constituent (c)
  (format t "~A" c)
  (and (graphic-char-p c)
       (not (char= c #\ ))))

;;;Exercise 2 
(defun bin-search (obj vec &optional (key #'identity) (test #'>))
  (let ((len (length vec)))
    (and (not (zerop len))
	 (finder obj vec test key))))

(defun finder (obj vec test key &optional (start 0) (end (length vec)))
  (let ((range (- end start)))
    (if (zerop range)
	(if (eql obj (funcall key (aref vec start)))
	    obj
	    nil))
    (let* ((mid (+ start (round (/ range 2))))
	   (obj2 (funcall key (aref vec mid))))
      (if (funcall test obj obj2)
	  (finder obj vec start (- mid 1))
	  (if (not (funcall test obj obj2))
	      (finder obj vec (+ mid 1) end)
	      obj)))))

;;;Exercise 4; most to return top 2 scoring results.
(defun most (fn lst)
  (if (null lst)
      (values nil nil nil nil)
      (let* ((wins (car lst))
	     (max (funcall fn wins))
	     (win2)
	     (max2))
	(dolist (obj (cdr lst))
	  (let ((score (funcall fn obj)))
	    (cond ((> score max)
		   (setf win2 wins
			 max2 max
			 max score
			 wins obj))
		  ((> score max2)
		   (setf win2 obj
			 max2 score)))))
	(values wins max win2 max2))))



;;;Exercise 5, remove-if in terms of filter utility
(defun filter (fn lst)
  (let (acc)
    (dolist (x lst)
      (let ((val (funcall fn x)))
	(if val 
	    (push x acc))))
    (nreverse acc)))

(defun our-remove-if (test seq)
  (filter test seq))


;;;Exercise 6, greatest value passed so far
(let ((max 0))
  (defun greatest-so-far (n)			     
    (if (> n max)
	(setf max n)
	max)))

;;;Exercise 7, greater than last value
(let (last)
  (defun greater-than-last (n)			     
    (let ((newlast last))
      (setf last n)
      (and newlast (> n newlast) t))))


;;;Exercise 8; expensive vs. frugal
(defun expensive (n)
  (sleep 10)
  n)

(let ((ans (make-array 101 :initial-element nil)))
  (defun frugal (n)
    (let ((val (svref ans n)))
      (if val
	  val
	  (setf (svref ans n) (expensive n))))))


;;;Exercise 9; apply with octal printing behavior
(defun apply-prints-octal (fn &rest args)
  (let ((*print-base* 8))
    (apply fn args)))


;;;;-------------Chapter 7 Solutions------------------------
;;;Exercise 1

(defun file2list (filename)
  (with-open-file (str filename :direction :input)
    (let (acc)
      (do ((line (read-line str nil :eof)
		 (read-line str nil :eof)))
	  ((eql line :eof))
	(push line acc))
      (reverse acc))))


;;;Exercise 2 - read expresions to list
(defun xpr2list (filename)
  (with-open-file (str filename :direction :input)
    (let (acc)
      (do ((line (read str nil :eof)
		 (read str nil :eof)))
	  ((eql line :eof))
	(push line acc))
      (reverse acc))))


;;;Exercise 3 - copy text without comments
(defun copy-text (file1 file2)
  (with-open-file (in file1 :direction :input)
    (with-open-file (out file2 :direction :output :if-exists :supersede)
      (do ((line (read-line in nil :eof)
		 (read-line in nil :eof)))
	  ((eql line :eof))
	(let ((pos (position #\% line)))
	  (cond (pos
		 (princ (subseq line 0 pos) out)
		 (terpri out))
		(t (princ line out))))))))


;;;Exercise 4 - pretty print array
(defun pprint-array (arr)
  (let ((arr-dim (array-dimensions arr)))
    (dotimes (i (first arr-dim))
      (dotimes (j (second arr-dim))
	(format t "~10,2F" (aref arr i j)))
      (terpri))))

;;;Exercise 5 and 6 - modify stream-subst from pg 129 to allow wild card +
(defun stream-subst (old new in out)
  (let* ((pos 0)
	 (len (length old))
	 (buf (new-buf len))
	 (from-buf nil))
    (do ((c (read-char in nil :eof)
	    (or (setf from-buf (buf-next buf))
		(read-char in nil :eof))))
	((eql c :eof))
      (cond ((pattern-matcher old pos c)
	     (incf pos)
	     (cond ((= pos len)
		    (princ new out)
		    (setf pos 0)
		    (buf-clear buf))
		   ((not from-buf)
		    (buf-insert c buf))))
	    ((zerop pos)
	     (princ c out)
	     (when from-buf
	       (buf-pop buf)
	       (buf-reset buf)))
	    (t 
	     (unless from-buf
	       (buf-insert c buf))
	     (princ (buf-pop buf) out)
	     (buf-reset buf)
	     (setf pos 0))))
    (buf-flush buf out)))

(defun pattern-matcher (pat pos char)
  (case (char pat pos)    
    (#\. (digit-char-p char))
    (#\- (alphanumericp char))
    (#\+ t)
    (otherwise (char= char (char pat pos)))))


;;;;---------------------------Chapter 8 solutions ------------------------------------
;;;henley program code taken from page 140

(defparameter *words* (make-hash-table :size 100000))

(defconstant maxword 100)

(defun read-text (pathname)
  (with-open-file (s pathname :direction :input)
    (let ((buffer (make-string maxword))
	  (pos 0))
      (do ((c (read-char s nil :eof)
	      (read-char s nil :eof)))
	  ((eql c :eof))
	(if (or (alpha-char-p c) (char= c #\'))
	    (progn
	      (setf (aref buffer pos) c)
	      (incf pos))
	    (progn 
	      (unless (zerop pos)
		(see (intern (string-downcase 
			      (subseq buffer 0 pos))))
		(setf pos 0))
	      (let ((p (punc c)))
		(if p (see p)))))))))


(defun punc (c)
  (case c
    (#\. '|.|) (#\, '|,|)
    (#\; '|;|) (#\! '|!|)
    (#\? '|?|)))

(let ((prev '|.|))
  (defun see (symb)
    (let ((pair (assoc symb (gethash prev *words*))))
      (if (null pair)
	  (push (cons symb 1) (gethash prev *words*))
	  (incf (cdr pair))))
    (setf prev symb)))
	    
	    

(defun generate-text (n &optional (prev '|.|) (str t))
  (if (zerop n)
      (terpri)
      (let ((next (random-next prev)))
	(generate-text (1- n) next str))))

(defun random-next (prev)
  (let* ((choices (gethash prev *words*))
	 (i (random (reduce #'+ choices 
			    :key #'cdr))))
    (dolist (pair choices)
      (if (minusp (decf i (cdr pair)))
	  (return (car pair))))))

(defun record-henley (n)
  (with-open-file (str "henley-output" :direction :output :if-exists :supersede)
    (generate-text n '|.| str)))

;;; Exercise 5; function read-quote and verify help determine whether the 
;;; text stored at pathname is a work produced by Henley. 
(defun read-quote (pathname)
  (with-open-file (s pathname :direction :input)
    (let ((buffer (make-string maxword))
	  (pos 0)
	  (acc))
      (do ((c (read-char s nil :eof)
	      (read-char s nil :eof)))
	  ((eql c :eof))
	(if (or (alpha-char-p c) (char= c #\'))
	    (progn
	      (setf (aref buffer pos) c)
	      (incf pos))
	    (progn 
	      (unless (zerop pos)
		(push (intern (string-downcase 
			      (subseq buffer 0 pos)))
		      acc)
		(setf pos 0))
	      (let ((p (punc c)))
		(if p (push p
			    acc))))))
      (verify (reverse acc)))))

(defun verify (acc)
  (if (and (not  (cdr acc))) 
      (format t "this is henley's work")
      (let ((choices (gethash (car acc) *words*)))
	(if (assoc (car (cdr acc)) choices)
	    (verify (cdr acc))
	    (format t "this is not henley's work")))))


;;;;--------------------------Chapter 9 solutions ----------------------
;;;Exercise 1 - check if non-decreasing  real number list is passed
(defun check-real-list (lst)
  (catch 'unreal
    (and lst
	 (reduce #'(lambda (p n)
		     (format t "~A , ~A ~%" p n)
		     (if (null p)
			 (throw 'unreal nil))
		     (if (and (realp n)(>= p n))
			 n
			 nil))
		 lst)
	 t)))


;;;Exercise 2 - coin denominations
(defun coin-denominatins (i) 
  (if (integerp i)
      (let ((acc)
	    (denom '(25 10 5 1))
	    (rem i))
	(dolist (dn denom)	    
	  (push (truncate (/ rem dn)) acc)	
	  (setf rem (mod rem dn)))
      (apply #'values acc))))
	   

;;;;-----------------------Chapter 12 Solutions -----------------------

;;; Exercise 3
(defun copy-queue (q)
  (cons (car q) (cdr q)))

;;; Exercise 4
(defun enqueue-in-front (q x)
  (let ((back (cdr q))
        (front (car q)))
    (setf (car q) (cons x front))
    (if (null back)
	(setf (cdr q) (list x)))
    q)) 

;;;Exercise 5
(defun shift-in-front (x q)
  (multiple-value-bind (cnt l) (remove-frm-list x (car q))
    (labels ((insrt (n o l)
               (cond ((zerop n) l) 
                     (t (cons o (insrt (- n 1) o l))))))
      (setf (car q) (insrt cnt x l))
      (setf (cdr q) (last (car q)))))
  q)
 
(defun remove-frm-list (x q)
  (cond ((null q) (values 0 nil))
        ((eql x (car q)) (multiple-value-bind (cnt l) (remove-frm-list x (cdr q))
                           (values (1+ cnt) l)))
        (t (multiple-value-bind (cnt l) (remove-frm-list x (cdr q))
             (values cnt
               (cons (car q) l))))))

;;;Exercise 6
(defun find-in-circular (obj lst)
  (labels ((find-cdr-rec (x l)
             (cond ((eql x (car l)) t)
		   ((eql lst (cdr l)) nil)
		   (t (find-cdr-rec x (cdr l))))))
    (find-cdr-rec obj lst)))


;;;Exercise 7 
(defun cdr-circular-p (lst)
  (labels ((is-cdr-circular (l)
             (cond ((null l) nil)
		   ((eql lst (cdr l)) t)
		   (t (is-cdr-circular (cdr l))))))
    (is-cdr-circular lst))) 

;;;Exercise 8
(defun car-circular-p (lst)
 (labels ((is-car-circular (l)
            (cond ((null l) nil)
	          ((eql lst (car l)) t)
                  (t (is-car-circular (cdr l))))))
  (is-car-circular lst))) 
  

;;;;------------------------------Chapter 10 Solutions
;;; Excercise 2
;;my-if is expressed as a fucntion here.
(defun my-if (test first &optional second)
    (cond (test first)
          (t second)))
          
;;if-mac is expressed a macro. On calling macroexpand-1 on the sample 
;;form doesn't shows any advantage of using a macro in this case.
;;For example:
;;(macroexpand-1 '(if-mac (< 24 43) (+ 4 6) (- 32 12))) returns 
;;(cond ((< 24 43) (+ 4 6)) (-32 12)) 
(defmacro if-mac (test first &optional second)
    `(cond (,test ,first)
           (t ,second)))

;;;Exercise 3
(defmacro with-gensym (syms &body body)
    `(let ,(mapcar #'(lambda(sym)
                        `(,sym (gensym)))
                    syms)
        ,@body))

;;************************************************************
;; This is an attempt the implement this macro using recursion        
(defmacro nth-expr-rec (n &rest args)
    (with-gensym (nx) 
        (let ((nx (1- n)))
            (if (= nx 0)
                (car args)    
                `(nth-expr-rec ,nx ,@(cdr args))))))
                
(defmacro nth-expr (n &rest args)
    (with-gensym (nx exprx) 
        `(let* ((,nx (1- ,n))
                (,exprx (nth ,nx ',args)))
           (eval ,exprx))))


;;;Exercise 4
(defmacro ntimes-rec (n &body body)
    (with-gensym (ng)
        (let ((ng n))
            (if (> ng 0)
                `(and ,@body (ntimes-rec ,(- ng 1) ,@body))))))

;;;Exercise 5
;;First Attempt - trying to use recursion and  gensyms - but it doesn't work. 
(defmacro n-of1 (n xpr)
    (with-gensym (ng xprg)
        `(let ((,ng (1-,n))
               (,xprg ,xpr))
           (if (> ,ng 0)
               (cons ,xprg (n-of1 ,ng ,xpr))
               (cons ,xprg nil)))))
               
;;Second Attempt - trying to use recursion but it work partially. 
;;This evaluates the following expression properly
;;(let ((x 0)) (n-of 5 (incf x)))
;;But fails is evaluating 
;;(let ((x 0)(i 5)) (n-of i (incf x)))
(defmacro n-of (n xpr)
    (let ((ng (- n 1)))
        (if (> ng 0)
            `(cons ,xpr (n-of ng xpr))
            `(cons ,xpr nil))))


;;Third Attempt -using do to implement the macro. This one works fine for
;;both the expressions above .  
(defmacro n-of2 (n xpr)
    (with-gensym (acc ng)
        `(let ((,acc)
               (,ng ,n))
            (do ((x 0 (+ x 1)))
                ((= x ,ng))
                (push ,xpr ,acc))
            (reverse ,acc)))) 
            
;;Fourth Attempt - writing a n-of macro using recursion. 
(defmacro n-ofrec (n xpr)
    (with-gensym (n-of3)
        `(labels ((,n-of3 (ng)
                    (if (> ng 1)
                        (cons ,xpr (,n-of3 (- ng 1)))
                        (cons ,xpr nil))))
        (,n-of3 ,n))))

;;;Exercise 6
;; This is a very complex solution to a simple problem. 
(defmacro nomod (lst &body body)
    (with-gensym (vals)
        `(let ((,vals (list ,@ lst))) 
            ,@body
            ,@(let (acc)
                (dotimes (x (length lst) acc)
                    (push `(setf ,(nth x lst) (nth ,x ,vals)) 
                          acc))))))
;;This is a very complex solution to a simple problem. 
(defmacro nomod1 (lst &body body)
  (with-gensym (vals)
    `(let ((,vals (list ,@lst)))
       ,@ body
       (setf ,@(mapcan #'(lambda (var)
                           (list var `(nth ,(position var lst) ,vals)))
                       lst))))) 

;;This is the correct implementation of exercise 6. 
(defmacro reset-var (lst &body body)
  `(let (,@lst)
     ,@body))


;;;Exercise 8
(define-modify-macro doubler () (lambda (v) (* 2 v)))


